﻿'****************************************************************************
' 機能名    : modFtp.bas
' 機能説明  : FTP(File Transfer Protocol)送受信
' 備考      :
' 著作権    : Copyright(C) 2008 のん All rights reserved
' ---------------------------------------------------------------------------
' 使用条件  : このサイトの内容を使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このサイトを参考にした旨を記述してく
'           : ださい。(例)WEBページやReadMeにリンクを貼ってください
' ---------------------------------------------------------------------------
'****************************************************************************

Option Strict Off
Option Explicit On
Imports System.Runtime.InteropServices

Module modFtpTrans
    ' API用のConst定義
    Private Const ERROR_NO_MORE_FILES As Short = 18
    Private Const ERROR_INTERNET_EXTENDED_ERROR As Short = 12003
    Private Const FILE_ATTRIBUTE_READONLY As Integer = &H1
    Private Const FILE_ATTRIBUTE_HIDDEN As Integer = &H2
    Private Const FILE_ATTRIBUTE_SYSTEM As Integer = &H4
    Private Const FILE_ATTRIBUTE_DIRECTORY As Integer = &H10
    Private Const FILE_ATTRIBUTE_ARCHIVE As Integer = &H20
    Private Const FILE_ATTRIBUTE_NORMAL As Integer = &H80
    Private Const FILE_ATTRIBUTE_TEMPORARY As Integer = &H100
    Private Const FILE_ATTRIBUTE_COMPRESSED As Integer = &H800
    Private Const FILE_ATTRIBUTE_OFFLINE As Integer = &H1000
    Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Integer = &H100
    Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Integer = &H2000
    Private Const FORMAT_MESSAGE_FROM_HMODULE As Integer = &H800
    Private Const FORMAT_MESSAGE_FROM_STRING As Integer = &H400
    Private Const FORMAT_MESSAGE_FROM_SYSTEM As Integer = &H1000
    Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Integer = &H200
    Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Integer = &HFF
    Private Const FTP_TRANSFER_TYPE_BINARY As Integer = &H2
    Private Const FTP_TRANSFER_TYPE_ASCII As Integer = &H1
    Private Const INTERNET_FLAG_NO_CACHE_WRITE As Integer = &H4000000
    Private Const INTERNET_FLAG_RELOAD As Integer = &H80000000
    Private Const INTERNET_FLAG_KEEP_CONNECTION As Integer = &H400000
    Private Const INTERNET_FLAG_MULTIPART As Integer = &H200000
    Private Const INTERNET_FLAG_PASSIVE As Integer = &H8000000
    Private Const INTERNET_OPEN_TYPE_PRECONFIG As Short = 0
    Private Const INTERNET_OPEN_TYPE_DIRECT As Short = 1
    Private Const INTERNET_OPEN_TYPE_PROXY As Short = 3
    Private Const INTERNET_INVALID_PORT_NUMBER As Short = 0
    Private Const INTERNET_SERVICE_FTP As Short = 1
    Private Const INTERNET_SERVICE_GOPHER As Short = 2
    Private Const INTERNET_SERVICE_HTTP As Short = 3
    Private Const LOAD_IGNORE_CODE_AUTHZ_LEVEL As Integer = &H10
    Private Const LOAD_LIBRARY_AS_DATAFILE As Integer = &H2
    Private Const LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE As Integer = &H40
    Private Const LOAD_LIBRARY_AS_IMAGE_RESOURCE As Integer = &H20
    Private Const LOAD_WITH_ALTERED_SEARCH_PATH As Integer = &H8

    ' API用のType定義
    Private Const MAX_PATH As Short = 260
    Private Structure FILETIME
        Public dwLowDateTime As Integer
        Public dwHighDateTime As Integer
    End Structure
    Private Structure WIN32_FIND_DATA
        Public dwFileAttributes As Integer
        Public ftCreationTime As FILETIME
        Public ftLastAccessTime As FILETIME
        Public ftLastWriteTime As FILETIME
        Public nFileSizeHigh As Integer
        Public nFileSizeLow As Integer
        Public dwReserved0 As Integer
        Public dwReserved1 As Integer

        'Public cFileName As String * MAX_PATH
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)> Public cFileName As String
        'Public cAlternate As String * 14
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=14)> Public cAlternate As String

    End Structure
    Private Structure SYSTEMTIME
        Public wYear As Short
        Public wMonth As Short
        Public wDayOfWeek As Short
        Public wDay As Short
        Public wHour As Short
        Public wMinute As Short
        Public wSecond As Short
        Public wMilliseconds As Short
    End Structure

    ' API定義
    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Integer, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Integer) As Integer
    Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Integer, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Integer, ByVal lFlags As Integer, ByVal lContext As Integer) As Integer
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Integer) As Integer
    Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Integer, ByVal lpszDirectory As String) As Integer
    Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Integer, ByVal lpszCurrentDirectory As String, ByRef lpdwCurrentDirectory As Integer) As Integer
    Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Integer, ByVal lpszDirectory As String) As Integer
    Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Integer, ByVal lpszDirectory As String) As Integer
    Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Integer, ByVal lpszSearchFile As String, ByRef lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Integer, ByVal dwContent As Integer) As Integer
    Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Integer, ByRef lpvFindData As WIN32_FIND_DATA) As Integer
    Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Integer, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Integer, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Integer
    Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Integer, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Integer
    Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Integer, ByVal lpszExisting As String, ByVal lpszNew As String) As Integer
    Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Integer, ByVal lpszFileName As String) As Integer
    Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (ByRef lpdwError As Integer, ByVal lpszBuffer As String, ByRef lpdwBufferLength As Integer) As Integer
    Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" (ByRef lpFiletime As FILETIME, ByRef lpSystemTime As SYSTEMTIME) As Integer
    Private Declare Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" (ByVal lpFileName As String, ByVal hFile As Integer, ByVal dwFlags As Integer) As Integer
    Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hModule As Integer) As Integer
    Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Integer, ByVal lpSource As Integer, ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByVal Arguments As Integer) As Integer

    ' その他定義
    Private Const SourceFile As String = "modFtp" ' ソース名
    Private lngInternetOpen As Integer ' オープンハンドル
    Private lngInternetConnect As Integer ' コネクトハンドル
    Private ErrNumber As Integer ' エラー番号
    Private ErrSource As String ' エラーソース
    Private ErrDescription As String ' エラー説明
    Private ErrHelpFile As String ' エラーヘルプファイル
    Private ErrHelpContext As Integer ' エラーヘルプコンテキスト

    ' 関数名    : FtpConnectServer
    ' 返り値    : 無し
    ' 引き数    : strServer  : サーバ名またはIPアドレス
    '           : strUser    : ユーザ名
    '           : strPswd    : パスワード
    '           : strProxy   : プロキシ名またはIPアドレス
    '           : blnPassive : パッシブFTP
    ' 機能説明  : FTPサーバ接続
    ' 備考      :
    Public Sub FtpConnectServer(ByVal strServer As String, ByVal strUser As String, ByVal strPswd As String, Optional ByVal strProxy As String = "", Optional ByVal blnPassive As Boolean = False)
        On Error GoTo ErrHandler

        ' インターネットオープン(FTPサーバ接続準備)
        If strProxy <> "" Then
            lngInternetOpen = InternetOpen("WININET", INTERNET_OPEN_TYPE_PROXY, strProxy, vbNullString, 0)
        Else
            lngInternetOpen = InternetOpen("WININET", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
        End If
        If lngInternetOpen = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        ' FTPサーバ接続
        Dim lngPassive As Integer : lngPassive = 0
        If blnPassive Then lngPassive = INTERNET_FLAG_PASSIVE
        lngInternetConnect = InternetConnect(lngInternetOpen, strServer, INTERNET_INVALID_PORT_NUMBER, strUser, strPswd, INTERNET_SERVICE_FTP, lngPassive, 0)
        If lngInternetConnect = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        FtpDisconnectServer()
        ErrorRaise()
    End Sub

    ' 関数名    : FtpDisconnectServer
    ' 返り値    : 無し
    ' 引き数    : 無し
    ' 機能説明  : FTPサーバ切断
    ' 備考      :
    Public Sub FtpDisconnectServer()
        On Error Resume Next

        ' FTPサーバ切断
        If lngInternetConnect <> 0 Then InternetCloseHandle(lngInternetConnect)
        ' インターネットクローズ
        If lngInternetOpen <> 0 Then InternetCloseHandle(lngInternetOpen)
        lngInternetConnect = 0
        lngInternetOpen = 0

    End Sub

    ' 関数名    : FtpCd
    ' 返り値    : 無し
    ' 引き数    : strDir  : サーバのディレクトリPATH
    ' 機能説明  : FTPサーバのディレクトリ変更
    ' 備考      :
    Public Sub FtpCd(ByVal strDir As String)
        On Error GoTo ErrHandler

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Sub
        End If

        ' CD要求送信
        Dim lngRtn As Long
        lngRtn = FtpSetCurrentDirectory(lngInternetConnect, strDir)

        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Sub

    ' 関数名    : FtpPwd
    ' 返り値    : カレントディレクトリ
    ' 引き数    : 無し
    ' 機能説明  : FTPサーバのカレントディレクトリ取得
    ' 備考      :
    Public Function FtpPwd() As String
        On Error GoTo ErrHandler
        FtpPwd = ""

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Function
        End If

        ' PWD要求送信
        Dim lngRtn As Long
        Dim strDir As String
        Dim lngDir As Long
        lngDir = MAX_PATH
        strDir = New String(Chr(0), MAX_PATH)
        lngRtn = FtpGetCurrentDirectory(lngInternetConnect, strDir, lngDir)
        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Function
        End If

        ' カレントディレクトリ取得
        FtpPwd = Left$(strDir, InStr(1, strDir, New String(Chr(0), 1), vbBinaryCompare) - 1)

        Exit Function
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Function

    ' 関数名    : FtpMkdir
    ' 返り値    : 無し
    ' 引き数    : strDir  : サーバのディレクトリPATH
    ' 機能説明  : FTPサーバのディレクトリ作成
    ' 備考      :
    Public Sub FtpMkdir(ByVal strDir As String)
        On Error GoTo ErrHandler

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Sub
        End If

        ' MKDIR要求送信
        Dim lngRtn As Long
        lngRtn = FtpCreateDirectory(lngInternetConnect, strDir)
        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Sub

    ' 関数名    : FtpRmdir
    ' 返り値    : 無し
    ' 引き数    : strDir  : サーバのディレクトリPATH
    ' 機能説明  : FTPサーバのディレクトリ削除
    ' 備考      :
    Public Sub FtpRmdir(ByVal strDir As String)
        On Error GoTo ErrHandler

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Sub
        End If

        ' RMDIR要求送信
        Dim lngRtn As Long
        lngRtn = FtpRemoveDirectory(lngInternetConnect, strDir)
        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Sub

    ' 関数名    : FtpLs
    ' 返り値    : 無し
    ' 引き数    : 無し
    ' 機能説明  : FTPサーバのディレクトリリスト取得
    ' 備考      : ファイル名またはディレクト名
    ' 2012.05.15
    Public Function FtpLs() As String()
        On Error GoTo ErrHandler
        Dim strRtnVal() As String : ReDim strRtnVal(-1)
        FtpLs = strRtnVal

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Function
        End If

        ' 必要なローカル変数定義
        Dim lngFirst As Long : lngFirst = 0
        Dim typData As WIN32_FIND_DATA
        Dim lngRtn As Long

        typData.cAlternate = ""

        ' 最初のファイル名取得要求送信
        typData.cFileName = New String(Chr(0), MAX_PATH)
        lngFirst = FtpFindFirstFile(lngInternetConnect, "*.*", typData, INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0)
        If lngFirst = 0 Then
            If Err.LastDllError <> ERROR_NO_MORE_FILES Then
                SetErrAndRaise(Err.LastDllError)
            End If
            Exit Function
        End If
        ' 最初のファイル名取得
        ReDim strRtnVal(0)
        strRtnVal(UBound(strRtnVal)) = typData.cFileName
        If (typData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "/"
        End If
        FtpLs = strRtnVal

        ' ２個目以降のファイル名取得要求送信
        Do
            typData.cFileName = New String(Chr(0), MAX_PATH)
            lngRtn = InternetFindNextFile(lngFirst, typData)
            If lngRtn = 0 Then
                If Err.LastDllError <> ERROR_NO_MORE_FILES Then
                    SetErrAndRaise(Err.LastDllError)
                End If
                Exit Do
            End If
            ' ２個目以降のファイル名取得
            ReDim Preserve strRtnVal(UBound(strRtnVal) + 1)
            strRtnVal(UBound(strRtnVal)) = typData.cFileName
            If typData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
                strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "/"
            End If
            FtpLs = strRtnVal
        Loop

        ' 最初のファイル名のハンドルクローズ
        InternetCloseHandle(lngFirst)
        Exit Function
ErrHandler:
        ErrorSave()
        If lngFirst <> 0 Then InternetCloseHandle(lngFirst)
        ErrorRaise()
    End Function

    ' 関数名    : FtpDir
    ' 返り値    : 無し
    ' 引き数    : 無し
    ' 機能説明  : FTPサーバのディレクトリリスト取得
    ' 備考      : ファイル名またはディレクト名、更新日時、サイズ
    '           : (注)ファイルサイズは2G以下しかサポートしていません
    ' 2012.05.15
    Public Function FtpDir() As String()
        On Error GoTo ErrHandler
        Dim strRtnVal() As String : ReDim strRtnVal(-1)
        FtpDir = strRtnVal

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Function
        End If

        ' 必要なローカル変数定義
        Dim lngFirst As Long : lngFirst = 0
        Dim typData As WIN32_FIND_DATA
        Dim lngRtn As Long

        typData.cAlternate = ""

        ' 最初のファイル名取得要求送信
        typData.cFileName = New String(Chr(0), MAX_PATH)
        lngFirst = FtpFindFirstFile(lngInternetConnect, "*.*", typData, INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0)
        If lngFirst = 0 Then
            If Err.LastDllError <> ERROR_NO_MORE_FILES Then
                SetErrAndRaise(Err.LastDllError)
            End If
            Exit Function
        End If
        ' 最初のファイル名取得
        ReDim strRtnVal(0)
        strRtnVal(UBound(strRtnVal)) = typData.cFileName
        If (typData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "/"
        End If
        strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "," & GetStrDTime(typData.ftLastWriteTime)    ' ファイルの更新日時
        strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "," & typData.nFileSizeLow                    ' ファイルのサイズ(2G以下)
        FtpDir = strRtnVal

        ' ２個目以降のファイル名取得要求送信
        Do
            typData.cFileName = New String(Chr(0), MAX_PATH)
            lngRtn = InternetFindNextFile(lngFirst, typData)
            If lngRtn = 0 Then
                If Err.LastDllError <> ERROR_NO_MORE_FILES Then
                    SetErrAndRaise(Err.LastDllError)
                End If
                Exit Do
            End If
            ' ２個目以降のファイル名取得
            ReDim Preserve strRtnVal(UBound(strRtnVal) + 1)
            strRtnVal(UBound(strRtnVal)) = typData.cFileName
            If typData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
                strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "/"
            End If
            strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "," & GetStrDTime(typData.ftLastWriteTime)    ' ファイルの更新日時
            strRtnVal(UBound(strRtnVal)) = strRtnVal(UBound(strRtnVal)) & "," & typData.nFileSizeLow                    ' ファイルのサイズ(2G以下)
            FtpDir = strRtnVal
        Loop

        ' 最初のファイル名のハンドルクローズ
        InternetCloseHandle(lngFirst)
        Exit Function
ErrHandler:
        ErrorSave()
        If lngFirst <> 0 Then InternetCloseHandle(lngFirst)
        ErrorRaise()
    End Function

    ' 関数名    : FtpGet
    ' 返り値    : 無し
    ' 引き数    : strLocalPath  : ローカルファイルのPATH
    '           : strRemotePath : リモートファイルのPATH
    '           : blnBinari    : バイナリ(True)またはアスキー(False)
    ' 機能説明  : ファイルをFTPサーバから受信(ダウンロード)
    ' 備考      :
    Public Sub FtpGet(ByVal strLocalPath As String, ByVal strRemotePath As String, Optional ByVal blnBinari As Boolean = True)
        On Error GoTo ErrHandler

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Sub
        End If

        ' バイナリまたはアスキーモードの設定
        Dim lngtype As Long
        lngtype = FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD
        If blnBinari = False Then
            lngtype = FTP_TRANSFER_TYPE_ASCII Or INTERNET_FLAG_RELOAD
        End If

        ' ファイルをFTPサーバから受信
        Dim lngRtn As Integer
        lngRtn = FtpGetFile(lngInternetConnect, strRemotePath, strLocalPath, False, FILE_ATTRIBUTE_NORMAL, lngtype, 0)
        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Sub

    ' 関数名    : FtpPut
    ' 返り値    : 無し
    ' 引き数    : strLocalPath  : ローカルファイルのPATH
    '           : strRemotePath : リモートファイルのPATH
    '           : blnBinari     : バイナリ(True)またはアスキー(False)
    ' 機能説明  : ファイルをFTPサーバへ送信(アップロード)
    ' 備考      :
    Public Sub FtpPut(ByVal strLocalPath As String, ByVal strRemotePath As String, Optional ByVal blnBinari As Boolean = True)
        On Error GoTo ErrHandler

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Sub
        End If

        ' バイナリまたはアスキーモードの設定
        Dim lngtype As Long
        lngtype = FTP_TRANSFER_TYPE_BINARY
        If blnBinari = False Then
            lngtype = FTP_TRANSFER_TYPE_ASCII
        End If

        ' ファイルをFTPサーバへ送信
        Dim lngRtn As Integer
        lngRtn = FtpPutFile(lngInternetConnect, strLocalPath, strRemotePath, lngtype, 0)
        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Sub

    ' 関数名    : FtpRename
    ' 返り値    : 無し
    ' 引き数    : strOld  : サーバのファイルやディレクトリPATH(既存)
    '           : strNew  : サーバのファイルやディレクトリPATH(新)
    ' 機能説明  : FTPサーバのファイルやディレクトリの名前変更
    ' 備考      :
    Public Sub FtpRename(ByVal strOld As String, ByVal strNew As String)
        On Error GoTo ErrHandler

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Sub
        End If

        ' RENAME要求送信
        Dim lngRtn As Long
        lngRtn = FtpRenameFile(lngInternetConnect, strOld, strNew)
        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Sub

    ' 関数名    : FtpDelete
    ' 返り値    : 無し
    ' 引き数    : strOld  : サーバのファイルPATH
    ' 機能説明  : FTPサーバのファイル削除
    ' 備考      :
    Public Sub FtpDelete(ByVal strFile As String)
        On Error GoTo ErrHandler

        ' FTPサーバ未接続の時はエラー
        If lngInternetOpen = 0 Then
            Err.Raise(9999, SourceFile, "It is not connected to the ftp server")
            Exit Sub
        End If

        ' DELETE要求送信
        Dim lngRtn As Long
        lngRtn = FtpDeleteFile(lngInternetConnect, strFile)
        If lngRtn = 0 Then
            SetErrAndRaise(Err.LastDllError)
            Exit Sub
        End If

        Exit Sub
ErrHandler:
        ErrorSave()
        ErrorRaise()
    End Sub

    ' 関数名    : GetStrDTime
    ' 返り値    : 無し
    ' 引き数    : ft : ファイルタイム
    ' 機能説明  : ファイルタイムをシステムタイム文字列変換
    ' 備考      :
    Private Function GetStrDTime(ByRef typFileTime As FILETIME) As String
        On Error Resume Next
        Dim typSystemTime As SYSTEMTIME
        Call FileTimeToSystemTime(typFileTime, typSystemTime)
        GetStrDTime = Format(typSystemTime.wYear, "0000") & "/" & Format(typSystemTime.wMonth, "00") & "/" & Format(typSystemTime.wDay, "00") & " " & Format(typSystemTime.wHour, "00") & ":" & Format(typSystemTime.wMinute, "00") & ":" & Format(typSystemTime.wSecond, "00")

    End Function

    ' 関数名    : SetErrAndRaise
    ' 返り値    : 無し
    ' 引き数    : lngDllError : Err.LastDllError
    ' 機能説明  : DLLエラーメッセージ取得＆エラー送信
    ' 備考      :
    Private Sub SetErrAndRaise(ByRef lngDllError As Integer)
        On Error Resume Next

        ErrNumber = lngDllError
        ErrSource = SourceFile
        ErrDescription = GetMessageFromDll(lngDllError, "WININET.DLL")

        If lngDllError = ERROR_INTERNET_EXTENDED_ERROR Then
            Dim lngError As Long
            Dim lngLength As Long
            Dim strMessage As String
            InternetGetLastResponseInfo(lngError, vbNullString, lngLength)
            strMessage = New String(Chr(0), lngLength + 1)
            InternetGetLastResponseInfo(lngError, strMessage, lngLength)

            ErrDescription = ErrDescription & vbCrLf & strMessage
        ElseIf lngDllError = ERROR_NO_MORE_FILES Then
            ErrDescription = ErrDescription & vbCrLf & "ERROR_NO_MORE_FILES"
        End If
        If ErrNumber = 0 Then ErrNumber = 9999

        On Error GoTo 0
        ErrorRaise()
    End Sub

    ' 関数名    : GetMessageFromDll
    ' 返り値    : DLLエラーメッセージ
    ' 引き数    : lngDllError : Err.LastDllError
    ' 機能説明  : DLLエラーメッセージ取得
    ' 備考      :
    Private Function GetMessageFromDll(ByVal lngDllError As Integer, ByVal strDllName As String) As String
        On Error Resume Next
        GetMessageFromDll = ""

        Dim lngFlags As Integer
        Dim lngDll As Integer
        Dim lngRtn As Integer
        Dim strBuffer As String : strBuffer = New String(vbNullChar, 1024)

        lngFlags = FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_MAX_WIDTH_MASK
        lngDll = LoadLibraryEx(strDllName, 0&, LOAD_LIBRARY_AS_DATAFILE)
        If (lngDll <> 0) Then lngFlags = lngFlags Or FORMAT_MESSAGE_FROM_HMODULE
        lngRtn = FormatMessage(lngFlags, lngDll, lngDllError, 0&, strBuffer, Len(strBuffer), 0&)
        If (lngDll <> 0) Then FreeLibrary(lngDll)
        If (lngRtn > 0) Then
            strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
        Else
            strBuffer = ""
        End If
        GetMessageFromDll = strBuffer
    End Function

    ' 関数名    : ErrorSave
    ' 返り値    : 無し
    ' 引き数    : 無し
    ' 機能説明  : エラー保存
    ' 備考      :
    Private Sub ErrorSave()
        ErrNumber = Err.Number
        ErrSource = Err.Source
        ErrDescription = Err.Description
        ErrHelpFile = Err.HelpFile
        ErrHelpContext = Err.HelpContext
    End Sub

    ' 関数名    : ErrorRaise
    ' 返り値    : 無し
    ' 引き数    : 無し
    ' 機能説明  : エラー送信
    ' 備考      :
    Private Sub ErrorRaise()
        Err.Raise(ErrNumber, ErrSource, ErrDescription, ErrHelpFile, ErrHelpContext)
    End Sub
End Module

